home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / SHDK_2 / SHLNGSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-13  |  47KB  |  1,490 lines

  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. {$D-,L-}
  6.  
  7. {**********************************************************************}
  8. {**************     DO NOT MODIFY THE NEXT DIRECTIVE     **************}
  9. {**********************************************************************}
  10.  
  11. {$R-,V-}
  12.  
  13. unit ShLngStr;
  14. {
  15.                                 ShLngStr
  16.  
  17.                     A Long String Manipulation Unit
  18.  
  19.                                    by
  20.  
  21.                               Bill Madison
  22.  
  23.                    W. G. Madison and Associates, Ltd.
  24.                           13819 Shavano Downs
  25.                             P.O. Box 780956
  26.                        San Antonio, TX 78278-0956
  27.                              (512)492-2777
  28.                              CIS 73240,342
  29.  
  30.                   Copyright 1991 Madison & Associates
  31.                           All Rights Reserved
  32.  
  33.         This file may  be used and distributed  only in accord-
  34.         ance with the provisions described on the title page of
  35.                   the accompanying documentation file
  36.                               SKYHAWK.DOC
  37. }
  38.  
  39. interface
  40.  
  41. uses
  42.   ShErrMsg,
  43.   TpInline,
  44.   TpString,
  45.   TpMemChk;
  46.  
  47. const
  48.   MaxLongString = 65517;                    {Maximum length of LongString.}
  49.  
  50. type
  51.   LongStringType= record
  52.                     Length,                 {Dynamic length}
  53.                     dLength : word;         {"Declared" length}
  54.                     lsData  : array[1..1] of char;
  55.                     end;
  56.   LongString    = ^LongStringType;
  57.   lsCompType    = (Less, Equal, Greater);
  58.   lsDelimSetType= set of char;
  59.   CharSet       = set of char;
  60.  
  61. const
  62.   lsDelimSet    : lsDelimSetType = [#0..#32];
  63.   lsNotFound                     =  0;      {Returned by Pos functions if
  64.                                               substring not found}
  65.   RingSize      : byte           = 25;
  66.   lsHaltErr     : boolean        = true;    {Stop program execution on
  67.                                               non-I/O errors}
  68.  
  69. {NON-I/O ERROR CODES}
  70.   lsOK                          =   0;
  71.                                 {Last operation OK.}
  72.   lsInitError                   = 250;
  73.                                 {System initialization not performed.}
  74.   lsStringTooLong               = 251;
  75.                                 {Declared string length > MaxLongString.}
  76.   lsAllocError                  = 252;
  77.                                 {Not enough heap space for long string.}
  78.   lsRingAllocError              = 253;
  79.                                 {Not enough heap space for long string
  80.                                  allocation from ring buffer.}
  81.   lsRuntimeError      : word    = lsOK;
  82.                                 {Result of last operation.}
  83.  
  84.   {========== MEMORY MANAGEMENT =============================================}
  85.  
  86. procedure lsSysInit;
  87.   {Initializes the LngStr system.}
  88.  
  89. procedure lsSysDeinit;
  90.   {Deinitializes the LngStr system, releasing the ring buffer and the
  91.    associated heap space.}
  92.  
  93. function lsInit(var A  : LongString; L : word)  : boolean;
  94.   {"Declares" a LongString of maximum declared length L and establishes
  95.    space for it on the heap. Returns false if L is greater than
  96.    MaxLongString or not enough heap space.}
  97.  
  98. procedure lsDispose(var A : LongString);
  99.   {-Dispose of A, releasing its heap space}
  100.  
  101.   {========== GENERAL HOUSEKEEPING ==========================================}
  102.  
  103. function lsComp(A1, A2 : LongString) : lsCompType;
  104.   {-Compares A1 to A2, returning LESS, EQUAL, or GREATER}
  105.  
  106. function lsCount(A, Obj : LongString):  word;
  107. function lsCountStr(A : LongString; Obj : string) : word;
  108.   {-Returns the number of occurrences of Obj in A}
  109.  
  110. function lsCountUC(A, Obj : LongString):  word;
  111. function lsCountStrUC(A : LongString; Obj : string) : word;
  112.   {-Returns the number of occurrences of Obj in A}
  113.   { The search is not CASE SENSITIVE.}
  114.  
  115. function lsLength(A : LongString) : word;
  116.   {-Return the length of a LongString. A must have been lsInited}
  117.  
  118. function lsPos(Obj, A : LongString) : word;
  119. function lsPosStr(Obj : string; A : LongString) : word;
  120.   {-Return the position of Obj in A, returning lsNotFound if not found}
  121.  
  122. function lsPosSet(A : CharSet; S : LongString) : word;
  123.   {-Returns the earliest position of any member of A in S.}
  124.  
  125. function lsPosUC(Obj, A : LongString) : word;
  126. function lsPosStrUC(Obj : string; A : LongString) : word;
  127.   {-Return the position of Obj in A, returning lsNotFound if not found.
  128.    The search is not CASE SENSITIVE.}
  129.  
  130. function lsSizeOf(A : LongString) : word;
  131.   {-Returns the total heap space required for A. A must have been lsInited}
  132.  
  133.   {========== LONGSTRING TRANSFER (ASSIGNMENT) ==============================}
  134.  
  135. procedure lsTransfer(A, B : LongString);
  136.   {Transfers the contents of A into B}
  137.   {NOTE: B^ := A^ yields unpredictable results. DO NOT USE!
  138.  
  139.   {========== STRING <-> LONGSTRING TYPE CONVERSION =========================}
  140.  
  141. function lsLongString2Str(A : LongString) : string;
  142.   {-Convert LongString to Turbo string, truncating if longer than 255 chars}
  143.  
  144. procedure lsStr2LongString(S : string; A : LongString);
  145. function lsStr2LongStringF(S : string)  : LongString;
  146.   {-Convert a Turbo string into a LongString}
  147.  
  148.   {========== MANIPULATING LONGSTRINGS, STRINGS =============================}
  149.  
  150. procedure lsConcat(A, B, C : LongString);
  151. function lsConcatF(A, B : LongString) : LongString;
  152.   {-Concatenate two LongString strings, returning a third}
  153.  
  154. procedure lsConcatStr2Ls(A : LongString; S : string; C : LongString);
  155. function lsConcatStr2LsF(A : LongString; S : string)  : LongString;
  156.   {-Concatenate a string to a LongString, returning a new LongString}
  157.  
  158. procedure lsConcatLs2Str(S : string; A : LongString; C : LongString);
  159. function lsConcatLs2StrF(S : string; A : LongString)  : LongString;
  160.   {-Concatenate a LongString to a string, returning a new LongString}
  161.  
  162.   {========== SUBSTRINGS OF LONGSTRINGS, STRINGS ============================}
  163.  
  164. procedure lsCopy(A  : LongString; Start, Len  : word; B : LongString);
  165. function lsCopyF(A  : LongString; Start, Len  : word)  : LongString;
  166.   {-Return a long substring of A. Note Start=1 for first char in A}
  167.  
  168. procedure lsDelete(A : LongString; Start, Len : word; B : LongString);
  169. function lsDeleteF(A : LongString; Start, Len : word) : LongString;
  170.   {-Delete Len characters of A, starting at position Start}
  171.  
  172. procedure lsInsert(A, Obj : LongString; Start : word; B : LongString);
  173. function lsInsertF(A, Obj : LongString; Start : word) : LongString;
  174.   {-Insert LongString Obj into A at position Start returning a new LongString}
  175.  
  176. procedure lsInsertStr(A : LongString; Obj : string;
  177.                       Start : word; B : LongString);
  178. function lsInsertStrF(A : LongString; Obj : string;
  179.                       Start : word) : LongString;
  180.   {-Insert string Obj into A at position Start returning a new LongString}
  181.  
  182. procedure lsGetNext(LS1, LS2  : LongString);
  183. function lsGetNextF(LS1 : LongString) : LongString;
  184. procedure lsGetNextStr(LS1  : LongString; var S2  : string);
  185. function lsGetNextStrF(LS1  : LongString) : string;
  186.   {-Returns the next substring of LS1 which is delimited by a member
  187.     of lsDelimSet.)
  188.  
  189.   {========== LONGSTRING TRANSFORMATIONS ====================================}
  190.  
  191. procedure lsCenter(A : LongString; Width : word; B : LongString);
  192. function lsCenterF(A : LongString; Width : word)  : LongString;
  193.   {-Return a LongString centered in a LongString of blanks with specified
  194.     width}
  195.  
  196. procedure lsCenterCh(A : LongString; Ch : Char; Width : word; B : LongString);
  197. function lsCenterChF(A : LongString; Ch : Char; Width : word) : LongString;
  198.   {-Return a LongString centered in a LongString of Ch with specified width}
  199.  
  200. procedure lsCharStr(Ch : Char; Len : word; A : LongString);
  201. function lsCharStrF(Ch : Char; Len : word) : LongString;
  202.   {-Return a LongString of length Len filled with Ch}
  203.  
  204. procedure lsLeftPad(A : LongString; Len : word; B : LongString);
  205. function lsLeftPadF(A : LongString; Len : word) : LongString;
  206.   {-Left-pad the LongString in A to length Len with blanks, returning
  207.     a new LongString}
  208.  
  209. procedure lsLeftPadCh(A : LongString; Ch : Char; Len : word; B : LongString);
  210. function lsLeftPadChF(A : LongString; Ch : Char; Len : word)  : LongString;
  211.   {-Left-pad the LongString in A to length Len with Ch, returning a new
  212.     LongString}
  213.  
  214. procedure lsLocase(A, B : LongString);
  215. function lsLocaseF(A  : LongString) : LongString;
  216.   {-Lowercase the LongString in A, returning a new LongString}
  217.  
  218. procedure lsPad(A : LongString; Len : word; B : LongString);
  219. function lsPadF(A : LongString; Len : word) : LongString;
  220.   {-Right-pad the LongString in A to length Len with blanks, returning
  221.     a new LongString}
  222.  
  223. procedure lsPadCh(A : LongString; Ch : Char; Len : word; B : LongString);
  224. function lsPadChF(A : LongString; Ch : Char; Len : word)  : LongString;
  225.   {-Right-pad the LongString in A to length Len with Ch, returning
  226.     a new LongString}
  227.  
  228. procedure lsTrim(A, B : LongString);
  229. function lsTrimF(A  : LongString) : LongString;
  230.   {-Return a LongString with leading and trailing white space removed}
  231.  
  232. procedure lsTrimLead(A, B : LongString);
  233. function lsTrimLeadF(A  : LongString): LongString;
  234.   {-Return a LongString with leading white space removed}
  235.  
  236. procedure lsTrimTrail(A, B : LongString);
  237. function lsTrimTrailF(A : LongString) : LongString;
  238.   {-Return a LongString with trailing white space removed}
  239.  
  240. procedure lsTrimLeadSet(A : LongString; CS : CharSet; B : LongString);
  241. function lsTrimLeadSetF(A : LongString; CS : CharSet) : LongString;
  242.   {-Returns a LongString with leading characters in CS stripped.}
  243.  
  244. procedure lsTrimTrailSet(A : LongString; CS : CharSet; B : LongString);
  245. function lsTrimTrailSetF(A : LongString; CS : CharSet) : LongString;
  246.   {-Returns a LongString with trailing characters in CS stripped.}
  247.  
  248. procedure lsTrimSet(A : LongString; CS : CharSet; B : LongString);
  249. function lsTrimSetF(A  : LongString; CS : CharSet) : LongString;
  250.   {-Returns a LongString with characters in CS stripped.}
  251.  
  252. procedure lsUpcase(A, B : LongString);
  253. function lsUpcaseF(A  : LongString) : LongString;
  254.   {-Uppercase the LongString in A, returning a new LongString}
  255.  
  256.   {========== GLOBAL PROCESSING =============================================}
  257.  
  258. procedure lsDelAll(A, Obj, B : LongString);
  259. function lsDelAllF(A, Obj : LongString):  LongString;
  260. procedure lsDelAllStr(A : LongString; Obj : string; B : LongString);
  261. function lsDelAllStrF(A : LongString; Obj : string) : LongString;
  262.   {-Deletes all occurrences of Obj in A}
  263.  
  264. procedure lsDelAllUC(A, Obj, B : LongString);
  265. function lsDelAllUCF(A, Obj : LongString):  LongString;
  266. procedure lsDelAllStrUC(A : LongString; Obj : string; B : LongString);
  267. function lsDelAllStrUCF(A : LongString; Obj : string) : LongString;
  268.   {-Deletes all occurrences of Obj in A}
  269.   { The search is not CASE SENSITIVE.}
  270.  
  271. procedure lsRepAll(A, Obj, Obj1, B : LongString);
  272. function lsRepAllF(A, Obj, Obj1 : LongString):  LongString;
  273. procedure lsRepAllStr(A : LongString; Obj, Obj1 : string; B : LongString);
  274. function lsRepAllStrF(A : LongString; Obj, Obj1 : string) : LongString;
  275.   {-Replaces all occurrences of Obj in A with Obj1}
  276.  
  277. procedure lsRepAllUC(A, Obj, Obj1, B : LongString);
  278. function lsRepAllUCF(A, Obj, Obj1 : LongString):  LongString;
  279. procedure lsRepAllStrUC(A : LongString; Obj, Obj1 : string; B : LongString);
  280. function lsRepAllStrUCF(A : LongString; Obj, Obj1 : string) : LongString;
  281.   {-Replaces all occurrences of Obj in A with Obj1}
  282.   { The search is not CASE SENSITIVE.}
  283.  
  284.   {========== INPUT / OUTPUT ================================================}
  285.  
  286. procedure lsReadLn(var F : Text; A : LongString);
  287.   {-Read a LongString from text file}
  288.  
  289. procedure lsWriteLn(var F : Text; A : LongString);
  290.   {-Write a LongString to text file}
  291.  
  292. procedure lsIon;
  293.   {-Has the same effect with respect to lsReadLn, lsWriteLn as the $I+
  294.     compiler has with respect to normal I/O operations, except that
  295.     the reported error address is meaningless.}
  296.  
  297. procedure lsIoff;
  298.   {-Has the same effect with respect to lsReadLn, lsWriteLn as the $I-
  299.     compiler has with respect to normal I/O operations, except that
  300.     the reported error address is meaningless.}
  301.  
  302. function lsIoResult : word;
  303.   {-Returns the value of IoResult resulting from the last lsReadLn or
  304.     lsWriteLn. NOTE: You MUST use lsIoResult for checking lsReadLn,
  305.     lsWriteLn. If you call IoResult instead, you will always get a 0
  306.     return.}
  307.  
  308. implementation
  309.  
  310.  
  311. const
  312.   Blank               : char    = #32;
  313.   MaxRingSize                   = 100;
  314.   RingSizeM1                    = MaxRingSize - 1;
  315.  
  316.   lsSysInited         : boolean = false;
  317.   lsMinErrNum                   = 250;
  318.   lsMaxErrNum                   = 255;
  319.  
  320.   lsIoRes             : word    = 0;
  321.   lsIoCheck           : boolean = true;
  322.  
  323. type
  324.   lsErrorNum                    = lsMinErrNum..lsMaxErrNum;
  325.  
  326. const
  327.   lsError             : array[lsErrorNum] of string[50] =
  328.                        ('ShLngStr not initialized.',
  329.                         'Long String too long (65517).',
  330.                         'lsInit allocation failure.',
  331.                         'lsInit allocation failure on ring buffer.',
  332.                         '',
  333.                         '');
  334.  
  335. var
  336.   Ring       : array[0..RingSizeM1] of LongString;
  337.   RingPtr    : ShortInt;
  338.  
  339. procedure ChkInit;
  340.   begin
  341.     if not lsSysInited then
  342.       RunErrorMsg(lsInitError, lsError[lsInitError]);
  343.     end;
  344.  
  345. procedure lsSysInit;
  346.   begin {lsSysInit}
  347.     if lsSysInited then exit;
  348.     if RingSize > MaxRingSize then begin
  349.       WriteLn('RingSize (',RingSize,') > MaxRingSize (',MaxRingSize,')');
  350.       WriteLn('Resetting to ',MaxRingSize);
  351.       RingSize := MaxRingSize;
  352.       end;
  353.     for RingPtr := 0 to RingSizeM1 do
  354.       Ring[RingPtr] := nil;
  355.     RingPtr := -1;
  356.     lsSysInited := true;
  357.     end; {lsSysInit}
  358.  
  359. procedure lsSysDeInit;
  360.   begin {lsSysDeInit}
  361.     if not lsSysInited then exit;
  362.     for RingPtr := 0 to RingSizeM1 do begin
  363.       if Ring[RingPtr] <> nil then
  364.         FreeMemCheck(Ring[RingPtr],
  365.                      Ring[RingPtr]^.dLength + (2 * SizeOf(word)));
  366.       Ring[RingPtr] := nil;
  367.       end;
  368.     RingPtr := -1;
  369.     lsSysInited := false;
  370.     end; {lsSysDeInit}
  371.  
  372. function Ptr2Str(P:pointer) : string; {For debugging only!}
  373.   begin
  374.     Ptr2Str := HexPtr(Normalized(P));
  375.     end;
  376.  
  377. function max(X, Y : word) : word;
  378.   begin
  379.     if X >= Y then
  380.       max := X
  381.     else
  382.       max := Y;
  383.     end; {max}
  384.  
  385. function min(X, Y : word) : word;
  386.   begin
  387.     if X <= Y then
  388.       min := X
  389.     else
  390.       min := Y;
  391.     end; {min}
  392.  
  393. function lsInitPrim(var A  : LongString; L, Err : word)  : boolean;
  394.   {"Declares" a LongString of maximum declared length L and establishes
  395.    space for it on the heap. Returns false if L is greater than
  396.    MaxLongString or not enough heap space.}
  397.   var
  398.     B1  : boolean;
  399.   begin
  400.     if L > MaxLongString then begin
  401.       lsInitPrim := false;
  402.       if lsHaltErr then
  403.         RunErrorMsg(lsStringTooLong, lsError[lsStringTooLong])
  404.       else
  405.         lsRuntimeError := lsStringTooLong;
  406.       exit;
  407.       end {if}
  408.     else begin
  409.       B1 := GetMemCheck(A, L+(2*SizeOf(word)));
  410.       if not B1 then begin
  411.         lsInitPrim := false;
  412.         if lsHaltErr then
  413.           RunErrorMsg(Err, lsError[Err])
  414.         else
  415.           lsRuntimeError := Err;
  416.         end; {if not B1}
  417.       lsInitPrim := true;
  418.       A^.dLength := L;
  419.       A^.Length := 0;
  420.       end; {else}
  421.     end; {lsInitPrim}
  422.  
  423. procedure lsDispose(var A : LongString);
  424.   {-Dispose of A, releasing its heap space}
  425.   begin
  426.     FreeMemCheck(A, A^.dLength+(2*SizeOf(word)));
  427.     A := nil;
  428.     end; {lsDispose}
  429.  
  430. function lsInit(var A  : LongString; L : word) : boolean;
  431.   begin {lsInit}
  432.     lsInit := lsInitPrim(A, L, lsAllocError);
  433.     end; {lsInit}
  434.  
  435. function NextInRing(L  : word) : LongString;
  436.   {-lsInits the next LongString on the ring buffer, lsDisposing of its
  437.     current contents, if any.}
  438.   begin
  439.     ChkInit;
  440.     RingPtr := (RingPtr+1) mod RingSize;
  441.     if Ring[RingPtr] <> nil then
  442.       lsDispose(Ring[RingPtr]);
  443.     if not lsInitPrim(Ring[RingPtr], L, lsRingAllocError) then begin
  444.       NextInRing := nil;
  445.       end
  446.     else
  447.       NextInRing := Ring[RingPtr];
  448.     end; {NextInRing}
  449.  
  450. procedure lsTransfer(A, B : LongString);
  451.   {Transfers the contents of A to B.
  452.    Truncates if the declared length of B is less than the length of A.}
  453.   begin
  454.     if Normalized(A) = Normalized(B) then exit;
  455.     B^.Length := min(A^.Length, B^.dLength);
  456.     move(A^.lsData, B^.lsData, B^.Length);
  457.     end; {lsTransfer}
  458.  
  459. function lsLength(A : LongString) : word;
  460.   {-Return the length of a LongString string}
  461.   begin
  462.     lsLength := A^.Length;
  463.     end; {lsLength}
  464.  
  465. function lsSizeOf(A : LongString) : word;
  466.   {-Returns the **declared** length of A + the overhead words}
  467.   begin
  468.     lsSizeOf := A^.dLength + (2*SizeOf(word));
  469.     end; {lsSizeOf}
  470.  
  471. function lsLongString2Str(A : LongString) : string;
  472.   {-Convert LongString to Turbo string, truncating if longer than 255 chars}
  473.   var
  474.     S : string;
  475.   begin
  476.     S[0] := char(min(A^.Length, 255));
  477.     move(A^.lsData, S[1], byte(S[0]));
  478.     lsLongString2Str := S;
  479.     end; {lsLongString2Str}
  480.  
  481. procedure lsStr2LongString(S : string; A : LongString);
  482.   {-Convert a Turbo string into a LongString. The LongString must have
  483.    been declared.}
  484.   begin
  485.     if A = nil then exit;
  486.     A^.Length := min(A^.dLength, byte(S[0]));
  487.     move(S[1], A^.lsData, A^.Length);
  488.     end; {lsStr2LongString}
  489.  
  490. function lsStr2LongStringF(S : string)  : LongString;
  491.   {-Convert a Turbo string into a LongString}
  492.   var
  493.     ThisLs  : LongString;
  494.   begin
  495.     ThisLs := NextInRing(byte(S[0]));
  496.     lsStr2LongStringF := ThisLs;
  497.     lsStr2LongString(S, ThisLs);
  498.     end; {lsStr2LongStringF}
  499.  
  500. procedure lsCopy(A  : LongString; Start, Len  : word; B : LongString);
  501.   {-Return a long substring of A. Note Start=1 for first char in A}
  502.   begin
  503.     if B = nil then exit;
  504.     if (A = nil) or (Start > A^.Length) then begin
  505.       B^.Length := 0;
  506.       exit;
  507.       end;
  508.     if ((Start-1) + Len) > A^.Length then
  509.       Len := A^.Length - Start + 1;
  510.     B^.Length := min(Len, B^.dLength);
  511.     move(A^.lsData[Start], B^.lsData, Len);
  512.     end; {lsCopy}
  513.  
  514. function lsCopyF(A  : LongString; Start, Len  : word)  : LongString;
  515.   {-Return a long substring of A. Note Start=1 for first char in A}
  516.   var
  517.     ThisLs  : LongString;
  518.   begin
  519.     ThisLs := NextInRing(Len);
  520.     lsCopyF := ThisLs;
  521.     lsCopy(A, Start, Len, ThisLs);
  522.     end; {lsCopyF}
  523.  
  524. procedure lsDelete(A : LongString; Start, Len : word; B : LongString);
  525.   {-Delete Len characters of A, starting at position Start}
  526.   begin
  527.     lsTransfer(A, B);
  528.     if Start > B^.Length then exit;
  529.     if Len > B^.Length - (Start - 1) then
  530.       Len := B^.Length - (Start - 1);
  531.     B^.Length := B^.Length - Len;
  532.     move(B^.lsData[Start+Len], B^.lsData[Start], B^.Length - (Start - 1));
  533.     end; {lsDelete}
  534.  
  535. function lsDeleteF(A  : LongString; Start, Len  : word) : LongString;
  536.   {-Delete Len characters of A, starting at position Start}
  537.   {-The function form returns A unchanged.}
  538.   var
  539.     ThisLs  : LongString;
  540.   begin
  541.     if Start > A^.Length then begin
  542.       lsDeleteF := nil;
  543.       exit;
  544.       end;
  545.     if Len > A^.Length - (Start - 1) then
  546.       Len := A^.Length - (Start - 1);
  547.     ThisLs := NextInRing(A^.Length - Len);
  548.     ThisLs^.Length := A^.Length - Len;
  549.     move(A^.lsData[1], ThisLs^.lsData[1], Start - 1);
  550.     move(A^.lsData[Start+Len], ThisLs^.lsData[Start], A^.Length - (Start - 1));
  551.     lsDeleteF := ThisLs;
  552.     end; {lsDeleteF}
  553.  
  554. procedure lsConcat(A, B, C : LongString);
  555.   {-Concatenate two LongString strings, returning a third}
  556.   var
  557.     CpyFromA,
  558.     CpyFromB  : word;
  559.   begin
  560.     if A^.Length > C^.dLength then begin
  561.       CpyFromA := C^.dLength;
  562.       CpyFromB := 0;
  563.       end
  564.     else begin
  565.       if A^.Length + B^.Length > C^.dLength then begin
  566.         CpyFromA := A^.Length;
  567.         CpyFromB := C^.dLength - CpyFromA;
  568.         end
  569.       else begin
  570.         CpyFromA := A^.Length;
  571.         CpyFromB := B^.Length;
  572.         end;
  573.       end;
  574.     C^.Length := CpyFromA + CpyFromB;
  575.     move(A^.lsData, C^.lsData, CpyFromA);
  576.     move(B^.lsData, C^.lsData[CpyFromA + 1], CpyFromB);
  577.     end; {lsConcat}
  578.  
  579. function lsConcatF(A, B : LongString) : LongString;
  580.   {-Concatenate two LongString strings, returning a third}
  581.   var
  582.     ThisLs  : LongString;
  583.     CpyFromB: word;
  584.   begin
  585.     if A^.Length + B^.Length > MaxLongString then
  586.       CpyFromB := MaxLongString - A^.Length
  587.     else
  588.       CpyFromB := B^.Length;
  589.     ThisLs := NextInRing(A^.Length + CpyFromB);
  590.     lsConcatF := ThisLs;
  591.     lsConcat(A, B, ThisLs);
  592.     end; {lsConcatF}
  593.  
  594. procedure lsConcatStr2Ls(A : LongString; S : string; C : LongString);
  595.   {-Concatenate a string to a LongString, returning a new LongString}
  596.   var
  597.     LS  : LongString;
  598.   begin
  599.     if not lsInit(LS, A^.Length + byte(S[0])) then exit;
  600.     lsStr2LongString(S, LS);
  601.     lsConcat(A, LS, C);
  602.     lsDispose(LS);
  603.     end; {lsConcatStr2Ls}
  604.  
  605. function lsConcatStr2LsF(A : LongString; S : string)  : LongString;
  606.   {-Concatenate a string to a LongString, returning a new LongString}
  607.   var
  608.     LS  : LongString;
  609.   begin
  610.     if not lsInit(LS, A^.Length + byte(S[0])) then exit;
  611.     lsStr2LongString(S, LS);
  612.     lsConcatStr2LsF := lsConcatF(A, LS);
  613.     lsDispose(LS);
  614.     end; {lsConcatStr2LsF}
  615.  
  616. procedure lsConcatLs2Str(S : string; A : LongString; C : LongString);
  617.   {-Concatenate a LongString to a string, returning a new LongString}
  618.   var
  619.     LS  : LongString;
  620.   begin
  621.     if not lsInit(LS, A^.Length + byte(S[0])) then exit;
  622.     lsStr2LongString(S, LS);
  623.     lsConcat(LS, A, C);
  624.     lsDispose(LS);
  625.     end; {lsConcatLs2Str}
  626.  
  627. function lsConcatLs2StrF(S : string; A : LongString)  : LongString;
  628.   {-Concatenate a LongString to a string, returning a new LongString}
  629.   var
  630.     LS  : LongString;
  631.   begin
  632.     if not lsInit(LS, A^.Length + byte(S[0])) then exit;
  633.     lsStr2LongString(S, LS);
  634.     lsConcatLs2StrF := lsConcatF(LS, A);
  635.     lsDispose(LS);
  636.     end; {lsConcatLs2StrF}
  637.  
  638. procedure lsInsert(A, Obj : LongString; Start : word; B : LongString);
  639.   {-Insert LongString Obj into A at position Start returning a new LongString}
  640.   var
  641.     FrontOfA,
  642.     RestOfA,
  643.     CpyFromO  : word;
  644.   begin
  645.     FrontOfA := min(Start-1, B^.dLength);
  646.     if (B^.dLength - FrontOfA) > Obj^.Length then
  647.       CpyFromO := Obj^.Length
  648.     else
  649.       CpyFromO := B^.dLength - FrontOfA;
  650.     if (B^.dLength - (FrontOfA + CpyFromO)) > (A^.Length - FrontOfA) then
  651.       RestOfA := A^.Length - FrontOfA
  652.     else
  653.       RestOfA := B^.dLength - (FrontOfA + CpyFromO);
  654.     B^.Length := FrontOfA + CpyFromO + RestOfA;
  655.     move(A^.lsData, B^.lsData, FrontOfA);
  656.     move(A^.lsData[Start], B^.lsData[FrontOfA + CpyFromO + 1], RestOfA);
  657.     move(Obj^.lsData, B^.lsData[Start], CpyFromO);
  658.     end; {lsInsert}
  659.  
  660. function lsInsertF(A, Obj : LongString; Start : word) : LongString;
  661.   {-Insert LongString Obj into A at position Start returning a new LongString}
  662.   var
  663.     ThisLs  : LongString;
  664.   begin
  665.     ThisLs := NextInRing(A^.Length + Obj^.Length);
  666.     lsInsertF := ThisLs;
  667.     lsInsert(A, Obj, Start, ThisLs);
  668.     end; {lsInsertF}
  669.  
  670. procedure lsInsertStr(A : LongString; Obj : string;
  671.                       Start : word; B : LongString);
  672.   {-Insert string Obj into A at position Start returning a new LongString}
  673.   var
  674.     LS  : LongString;
  675.   begin
  676.     if not lsInit(LS, byte(Obj[0])) then exit;
  677.     lsStr2LongString(Obj, LS);
  678.     lsInsert(A, LS, Start, B);
  679.     lsDispose(LS);
  680.     end; {lsInsertStr}
  681.  
  682. function lsInsertStrF(A : LongString; Obj : string;
  683.                       Start : word) : LongString;
  684.   {-Insert string Obj into A at position Start returning a new LongString}
  685.   var
  686.     LS  : LongString;
  687.   begin
  688.     if not lsInit(LS, byte(Obj[0])) then exit;
  689.     lsStr2LongString(Obj, LS);
  690.     lsInsertStrF := lsInsertF(A, LS, Start);
  691.     lsDispose(LS);
  692.     end; {lsInsertStrF}
  693.  
  694. procedure lsUpcase(A, B : LongString);
  695.   {-Uppercase the LongString in A, returning B}
  696.   var
  697.     W1    : word;
  698.   begin
  699.     lsTransfer(A, B);
  700.     for W1 := 1 to B^.Length do
  701.       B^.lsData[W1] := Upcase(B^.lsData[W1]);
  702.     end; {lsUpcase}
  703.  
  704. function lsUpcaseF(A  : LongString) : LongString;
  705.   {-Uppercase the LongString in A, returning B}
  706.   var
  707.     ThisLs  : LongString;
  708.   begin
  709.     ThisLs := NextInRing(A^.Length);
  710.     lsUpcase(A, ThisLs);
  711.     lsUpcaseF := ThisLs;
  712.     end; {lsUpcaseF}
  713.  
  714. procedure lsLocase(A, B : LongString);
  715.   {-Lowercase the LongString in A, returning B}
  716.   var
  717.     W1    : word;
  718.   begin
  719.     lsTransfer(A, B);
  720.     for W1 := 1 to B^.Length do
  721.       B^.lsData[W1] := Locase(B^.lsData[W1]);
  722.     end; {lsLocase}
  723.  
  724. function lsLocaseF(A  : LongString) : LongString;
  725.   {-Lowercase the LongString in A, returning B}
  726.   var
  727.     ThisLs  : LongString;
  728.   begin
  729.     ThisLs := NextInRing(A^.Length);
  730.     lsLocase(A, ThisLs);
  731.     lsLocaseF := ThisLs;
  732.     end; {lsLocaseF}
  733.  
  734. function lsComp(A1, A2 : LongString) : lsCompType;
  735.   {-Compares A1 to A2, returning LESS, EQUAL, or GREATER}
  736.   var
  737.     W1,
  738.     Search  : word;
  739.     LgthA1A2: lsCompType;
  740.   begin
  741.     if A1^.Length = A2^.Length then
  742.       LgthA1A2 := Equal
  743.     else
  744.       if A1^.Length < A2^.Length then
  745.         LgthA1A2 := Less
  746.       else
  747.         LgthA1A2 := Greater;
  748.     Search := min(A1^.Length, A2^.Length);
  749.     W1 := 1;
  750.     while (W1 < Search) and (A1^.lsData[W1] = A2^.lsData[W1]) do
  751.       inc(W1);
  752.     if A1^.lsData[W1] = A2^.lsData[W1] then begin
  753.       lsComp := LgthA1A2;
  754.       exit;
  755.       end;
  756.     if A1^.lsData[W1] < A2^.lsData[W1] then begin
  757.       lsComp := Less;
  758.       exit;
  759.       end;
  760.     if A1^.lsData[W1] > A2^.lsData[W1] then begin
  761.       lsComp := Greater;
  762.       end;
  763.     end; {lsComp}
  764.  
  765. function lsPosStr(Obj : string; A : LongString) : word;
  766.   {-Return the position of the string Obj in A, returning lsNotFound if
  767.    not found}
  768.   begin
  769.     lsPosStr := succ(Search(A^.lsData, A^.Length, Obj[1], byte(Obj[0])));
  770.     end; {lsPosStr}
  771.  
  772. function lsPos(Obj, A : LongString) : word;
  773.   {-Return the position of Obj in A, returning lsNotFound if not found}
  774.   begin
  775.     lsPos := succ(Search(A^.lsData, A^.Length, Obj^.lsData, Obj^.Length));
  776.     end; {lsPos}
  777.  
  778. function lsPosSet(A : CharSet; S : LongString) : word;
  779.   var
  780.     W1  : word;
  781.   begin
  782.     W1 := 1;
  783.     while (not (S^.lsData[W1] in A)) and (W1 < lsLength(S)) do
  784.       inc(W1);
  785.     if S^.lsData[W1] in A then
  786.       lsPosSet := W1
  787.     else
  788.       lsPosSet := 0;
  789.     end; {lsPosSet}
  790.  
  791. function lsPosStrUC(Obj : string; A : LongString) : word;
  792.   {-Return the position of the string Obj in A, returning lsNotFound if
  793.    not found. The search is not case sensitive.}
  794.   begin
  795.     lsPosStrUC := succ(SearchUC(A^.lsData, A^.Length, Obj[1], byte(Obj[0])));
  796.     end; {lsPosStrUC}
  797.  
  798. function lsPosUC(Obj, A : LongString) : word;
  799.   {-Return the position of Obj in A, returning lsNotFound if not found.
  800.    The search is not case sensitive.}
  801.   begin
  802.     lsPosUC := succ(SearchUC(A^.lsData, A^.Length, Obj^.lsData, Obj^.Length));
  803.     end; {lsPosUC}
  804.  
  805. function CountPrim(A, Obj : LongString;
  806.                    CaseSens  {true if case sensitive} : boolean)  : word;
  807.   var
  808.     Next,
  809.     Now,
  810.     Count : word;
  811.   begin
  812.     Next := 1;
  813.     Now := 1;
  814.     Count := 0;
  815.     repeat
  816.       if CaseSens then
  817.         Now := succ(Search(A^.lsData[Next], A^.Length-Next+1,
  818.                            Obj^.lsData, Obj^.Length))
  819.       else
  820.         Now := succ(SearchUC(A^.lsData[Next], A^.Length-Next+1,
  821.                            Obj^.lsData, Obj^.Length));
  822.       if Now <> 0 then begin
  823.         Next := Next + Now + Obj^.Length - 1;
  824.         inc(Count);
  825.         end;
  826.       until Now = 0;
  827.     CountPrim := Count;
  828.     end; {CountPrim}
  829.  
  830.   {-Returns the number of occurrences of Obj in A}
  831. function lsCount(A, Obj : LongString):  word;
  832.   begin
  833.     lsCount := CountPrim(A, Obj, true);
  834.     end; {lsCount}
  835. function lsCountStr(A : LongString; Obj : string) : word;
  836.   var
  837.     LS  : LongString;
  838.   begin
  839.     if not lsInit(LS, byte(Obj[0])) then exit;
  840.     lsStr2LongString(Obj, LS);
  841.     lsCountStr := lsCount(A, LS);
  842.     lsDispose(LS);
  843.     end; {lsCountStr}
  844.  
  845.   {-Returns the number of occurrences of Obj in A}
  846.   { The search is not CASE SENSITIVE.}
  847. function lsCountUC(A, Obj : LongString):  word;
  848.   begin
  849.     lsCountUC := CountPrim(A, Obj, false);
  850.     end; {lsCountUC}
  851. function lsCountStrUC(A : LongString; Obj : string) : word;
  852.   var
  853.     LS  : LongString;
  854.   begin
  855.     if not lsInit(LS, byte(Obj[0])) then exit;
  856.     lsStr2LongString(Obj, LS);
  857.     lsCountStrUC := lsCountUC(A, LS);
  858.     lsDispose(LS);
  859.     end; {lsCountStrUC}
  860.  
  861. procedure RepDelPrim(In0, Obj, Obj1, Out : LongString;
  862.                      RepOrDel, {true if to replace}
  863.                      CaseSens  {true if case sensitive} : boolean);
  864.   var
  865.     In1,
  866.     Scr   : LongString;
  867.     W1    : word;
  868.   function GetPos : word;
  869.     begin
  870.       if CaseSens then
  871.         GetPos := lsPos(Obj, In1)
  872.       else
  873.         GetPos := lsPosUC(Obj, In1);
  874.       end; {GetPos}
  875.   begin
  876.     if not lsInit(In1, In0^.Length) then exit;
  877.     lsTransfer(In0, In1);
  878.     W1 := GetPos;
  879.     if W1 = lsNotFound then begin
  880.       lsTransfer(In1, Out);
  881.       lsDispose(In1);
  882.       exit;
  883.       end;
  884.     if not lsInit(Scr, In1^.Length) then exit;
  885.     Out^.Length := 0;
  886.     while W1 <> lsNotFound do begin
  887.       lsCopy(In1, 1, W1-1, Scr);
  888.       lsConcat(Out, Scr, Out);
  889.       if RepOrDel then
  890.         lsConcat(Out, Obj1, Out);
  891.       lsDelete(In1, 1, W1 + Obj^.Length - 1, In1);
  892.       W1 := GetPos;
  893.       end; {while}
  894.     lsConcat(Out, In1, Out);
  895.     lsDispose(In1);
  896.     lsDispose(Scr);
  897.     end; {RepDelPrim}
  898.  
  899.   {-Deletes all occurrences of Obj in A}
  900. procedure lsDelAll(A, Obj, B : LongString);
  901.   begin
  902.     RepDelPrim(A, Obj, nil, B, false, true);
  903.     end; {lsDelAll}
  904. function lsDelAllF(A, Obj : LongString):  LongString;
  905.   var
  906.     LS  : LongString;
  907.   begin
  908.     LS := NextInRing(A^.Length - (lsCount(A, Obj) * Obj^.Length));
  909.     lsDelAll(A, Obj, LS);
  910.     lsDelAllF := LS;
  911.     end; {lsDelAllF}
  912. procedure lsDelAllStr(A : LongString; Obj : string; B : LongString);
  913.   var
  914.     LS  : LongString;
  915.   begin
  916.     if not lsInit(LS, A^.Length - (lsCountStr(A, Obj) * byte(Obj[0]))) then
  917.       exit;
  918.     lsStr2LongString(Obj, LS);
  919.     lsDelAll(A, LS, B);
  920.     lsDispose(LS);
  921.     end; {lsDelAllStr}
  922. function lsDelAllStrF(A : LongString; Obj : string) : LongString;
  923.   var
  924.     LS  : LongString;
  925.   begin
  926.     if not lsInit(LS, A^.Length - (lsCountStr(A, Obj) * byte(Obj[0]))) then
  927.       exit;
  928.     lsStr2LongString(Obj, LS);
  929.     lsDelAllStrF := lsDelAllF(A, LS);
  930.     lsDispose(LS);
  931.     end; {lsDelAllStrF}
  932.  
  933.   {-Deletes all occurrences of Obj in A}
  934.   { The search is not CASE SENSITIVE.}
  935. procedure lsDelAllUC(A, Obj, B : LongString);
  936.   begin
  937.     RepDelPrim(A, Obj, nil, B, false, false);
  938.     end; {lsDelAllUC}
  939. function lsDelAllUCF(A, Obj : LongString):  LongString;
  940.   var
  941.     LS  : LongString;
  942.   begin
  943.     LS := NextInRing(A^.Length - (lsCount(A, Obj) * Obj^.Length));
  944.     lsDelAllUC(A, Obj, LS);
  945.     lsDelAllUCF := LS;
  946.     end; {lsDelAllUCF}
  947. procedure lsDelAllStrUC(A : LongString; Obj : string; B : LongString);
  948.   var
  949.     LS  : LongString;
  950.   begin
  951.     if not lsInit(LS, A^.Length - (lsCountStrUC(A, Obj) * byte(Obj[0]))) then
  952.       exit;
  953.     lsStr2LongString(Obj, LS);
  954.     lsDelAllUC(A, LS, B);
  955.     lsDispose(LS);
  956.     end; {lsDelAllStrUC}
  957. function lsDelAllStrUCF(A : LongString; Obj : string) : LongString;
  958.   var
  959.     LS  : LongString;
  960.   begin
  961.     if not lsInit(LS, A^.Length - (lsCountStr(A, Obj) * byte(Obj[0]))) then
  962.       exit;
  963.     lsStr2LongString(Obj, LS);
  964.     lsDelAllStrUCF := lsDelAllUCF(A, LS);
  965.     lsDispose(LS);
  966.     end; {lsDelAllStrUCF}
  967.  
  968.   {-Replaces all occurrences of Obj in A with Obj1}
  969. procedure lsRepAll(A, Obj, Obj1, B : LongString);
  970.   begin
  971.     RepDelPrim(A, Obj, Obj1, B, true, true);
  972.     end; {lsRepAll}
  973. function lsRepAllF(A, Obj, Obj1 : LongString):  LongString;
  974.   var
  975.     LS    : LongString;
  976.   begin
  977.     LS := NextInRing(A^.Length +
  978.                     (lsCount(A, Obj) * (Obj1^.Length - Obj^.Length)));
  979.     lsRepAll(A, Obj, Obj1, LS);
  980.     lsRepAllF := LS;
  981.     end; {lsRepAllF}
  982. procedure lsRepAllStr(A : LongString; Obj, Obj1 : string; B : LongString);
  983.   var
  984.     LS0,
  985.     LS1  : LongString;
  986.   begin
  987.     if not lsInit(LS0, byte(Obj[0])) then exit;
  988.     lsStr2LongString(Obj, LS0);
  989.     if not lsInit(LS1, byte(Obj1[0])) then exit;
  990.     lsStr2LongString(Obj1, LS1);
  991.     lsRepAll(A, LS0, LS1, B);
  992.     lsDispose(LS0);
  993.     lsDispose(LS1);
  994.     end; {lsRepAllStr}
  995. function lsRepAllStrF(A : LongString; Obj, Obj1 : string) : LongString;
  996.   var
  997.     LS0,
  998.     LS1   : LongString;
  999.   begin
  1000.     if not lsInit(LS0, byte(Obj[0])) then exit;
  1001.     lsStr2LongString(Obj, LS0);
  1002.     if not lsInit(LS1, byte(Obj1[0])) then exit;
  1003.     lsStr2LongString(Obj1, LS1);
  1004.     lsRepAllStrF := lsRepAllF(A, LS0, LS1);
  1005.     lsDispose(LS0);
  1006.     lsDispose(LS1);
  1007.     end; {lsRepAllStrF}
  1008.  
  1009.   {-Replaces all occurrences of Obj in A with Obj1}
  1010.   { The search is not CASE SENSITIVE.}
  1011. procedure lsRepAllUC(A, Obj, Obj1, B : LongString);
  1012.   begin
  1013.     RepDelPrim(A, Obj, Obj1, B, true, false);
  1014.     end; {lsRepAllUC}
  1015. function lsRepAllUCF(A, Obj, Obj1 : LongString):  LongString;
  1016.   var
  1017.     LS    : LongString;
  1018.   begin
  1019.     LS := NextInRing(A^.Length +
  1020.                     (lsCountUC(A, Obj) * (Obj1^.Length - Obj^.Length)));
  1021.     lsRepAllUC(A, Obj, Obj1, LS);
  1022.     lsRepAllUCF := LS;
  1023.     end; {lsRepAllUCF}
  1024. procedure lsRepAllStrUC(A : LongString; Obj, Obj1 : string; B : LongString);
  1025.   var
  1026.     LS0,
  1027.     LS1  : LongString;
  1028.   begin
  1029.     if not lsInit(LS0, byte(Obj[0])) then exit;
  1030.     lsStr2LongString(Obj, LS0);
  1031.     if not lsInit(LS1, byte(Obj1[0])) then exit;
  1032.     lsStr2LongString(Obj1, LS1);
  1033.     lsRepAllUC(A, LS0, LS1, B);
  1034.     lsDispose(LS0);
  1035.     lsDispose(LS1);
  1036.     end; {lsRepAllStrUC}
  1037. function lsRepAllStrUCF(A : LongString; Obj, Obj1 : string) : LongString;
  1038.   var
  1039.     LS0,
  1040.     LS1   : LongString;
  1041.   begin
  1042.     if not lsInit(LS0, byte(Obj[0])) then exit;
  1043.     lsStr2LongString(Obj, LS0);
  1044.     if not lsInit(LS1, byte(Obj1[0])) then exit;
  1045.     lsStr2LongString(Obj1, LS1);
  1046.     lsRepAllStrUCF := lsRepAllUCF(A, LS0, LS1);
  1047.     lsDispose(LS0);
  1048.     lsDispose(LS1);
  1049.     end; {lsRepAllStrUCF}
  1050.  
  1051. procedure lsGetNextPrim(LS1, LS2  : LongString; Delims  : lsDelimSetType);
  1052.   var
  1053.     W1  : word;
  1054.   begin
  1055.     if lsLength(LS1) = 0 then begin
  1056.       LS2^.Length := 0;
  1057.       exit;
  1058.       end;
  1059.     W1 := 1;
  1060.     while (LS1^.lsData[W1] in Delims) and (W1 <= lsLength(LS1)) do
  1061.       inc(W1);
  1062.     dec(W1);
  1063.     lsDelete(LS1, 1, W1, LS1);
  1064.     if lsLength(LS1) = 0 then
  1065.       LS2^.Length := 0
  1066.     else begin
  1067.       W1 := 1;
  1068.       while (not (LS1^.lsData[W1] in Delims)) and (W1 <= lsLength(LS1)) do
  1069.         inc(W1);
  1070.       dec(W1);
  1071.       if W1 <> 0 then begin
  1072.         lsCopy(LS1, 1, W1, LS2);
  1073.         lsDelete(LS1, 1, W1, LS1);
  1074.         end
  1075.       else begin
  1076.         lsTransfer(LS1, LS2);
  1077.         LS1^.Length := 0;
  1078.         end;
  1079.       end;
  1080.     end; {lsGetNextPrim}
  1081.  
  1082. procedure lsGetNext(LS1, LS2  : LongString);
  1083.   begin
  1084.     lsGetNextPrim(LS1, LS2, lsDelimSet);
  1085.     end;
  1086.  
  1087. function lsGetNextF(LS1 : LongString) : LongString;
  1088.   var
  1089.     Scr,
  1090.     ThisLs  : LongString;
  1091.   begin
  1092.     if not lsInit(Scr, LS1^.Length) then exit;
  1093.     lsGetNextPrim(LS1, Scr, lsDelimSet);
  1094.     ThisLs := NextInRing(Scr^.Length);
  1095.     lsTransfer(Scr, ThisLs);
  1096.     lsDispose(Scr);
  1097.     lsGetNextF := ThisLs;
  1098.     end; {lsGetNextF}
  1099.  
  1100. procedure lsGetNextStr(LS1  : LongString; var S2  : string);
  1101.   var
  1102.     LS2     : LongString;
  1103.   begin
  1104.     if not lsInit(LS2, LS1^.Length) then exit;
  1105.     lsGetNextPrim(LS1, LS2, lsDelimSet);
  1106.     S2 := lsLongString2Str(LS2);
  1107.     lsDispose(LS2);
  1108.     end; {lsGetNextStr}
  1109.  
  1110. function lsGetNextStrF(LS1  : LongString) : string;
  1111.   var
  1112.     LS2     : LongString;
  1113.   begin
  1114.     if not lsInit(LS2, LS1^.Length) then exit;
  1115.     lsGetNextPrim(LS1, LS2, lsDelimSet);
  1116.     lsGetNextStrF := lsLongString2Str(LS2);
  1117.     lsDispose(LS2);
  1118.     end; {lsGetNextStrF}
  1119.  
  1120. procedure lsCharStr(Ch : Char; Len : word; A : LongString);
  1121.   {-Return a LongString of length Len filled with Ch}
  1122.   begin
  1123.     A^.Length := min(Len, A^.dLength);
  1124.     FillChar(A^.lsData, A^.Length, Ch);
  1125.     end; {lsCharStr}
  1126.  
  1127. function lsCharStrF(Ch : Char; Len : word) : LongString;
  1128.   {-Return a LongString of length Len filled with Ch}
  1129.   var
  1130.     ThisLs  : LongString;
  1131.   begin
  1132.     ThisLs := NextInRing(Len);
  1133.     lsCharStr(Ch, Len, ThisLs);
  1134.     lsCharStrF := ThisLs;
  1135.     end; {lsCharStrF}
  1136.  
  1137. procedure lsPadCh(A : LongString; Ch : Char; Len : word; B : LongString);
  1138.   {-Right-pad the LongString in A to length Len with Ch, returning B}
  1139.   var
  1140.     CpyFromA,
  1141.     LenOfCh   : word;
  1142.   begin
  1143.     Len := min(B^.dLength, Len);
  1144.     CpyFromA := min(A^.Length, Len);
  1145.     if Len > CpyFromA then
  1146.       LenOfCh := Len - CpyFromA
  1147.     else
  1148.       LenOfCh := 0;
  1149.     B^.Length := Len;
  1150.     move(A^.lsData, B^.lsData, CpyFromA);
  1151.     FillChar(B^.lsData[CpyFromA+1], LenOfCh, Ch);
  1152.     end; {lsPadCh}
  1153.  
  1154. function lsPadChF(A : LongString; Ch : Char; Len : word)  : LongString;
  1155.   {-Right-pad the LongString in A to length Len with Ch, returning B}
  1156.   var
  1157.     ThisLs  : LongString;
  1158.   begin
  1159.     ThisLs := NextInRing(Len);
  1160.     lsPadCh(A, Ch, Len, ThisLs);
  1161.     lsPadChF := ThisLs;
  1162.     end; {lsPadChF}
  1163.  
  1164. procedure lsPad(A : LongString; Len : word; B : LongString);
  1165.   {-Right-pad the LongString in A to length Len with blanks, returning B}
  1166.   begin
  1167.     lsPadCh(A, Blank, Len, B);
  1168.     end; {lsPad}
  1169.  
  1170. function lsPadF(A : LongString; Len : word) : LongString;
  1171.   {-Right-pad the LongString in A to length Len with blanks, returning B}
  1172.   begin
  1173.     lsPadF := lsPadChF(A, Blank, Len);
  1174.     end; {lsPad}
  1175.  
  1176. procedure lsLeftPadCh(A : LongString; Ch : Char; Len : word; B : LongString);
  1177.   {-Left-pad the LongString in A to length Len with Ch, returning B}
  1178.   var
  1179.     CpyFromA,
  1180.     LenOfCh   : word;
  1181.     ThisLs    : LongString;
  1182.   begin
  1183.     Len := min(B^.dLength, Len);
  1184.     ThisLs := NextInRing(Len);
  1185.     CpyFromA := min(A^.Length, Len);
  1186.     if Len > CpyFromA then
  1187.       LenOfCh := Len - CpyFromA
  1188.     else
  1189.       LenOfCh := 0;
  1190.     ThisLs^.Length := Len;
  1191.     move(A^.lsData, ThisLs^.lsData[LenOfCh+1], CpyFromA);
  1192.     FillChar(ThisLs^.lsData, LenOfCh, Ch);
  1193.     lsTransfer(ThisLs, B);
  1194.     end; {lsLeftPadCh}
  1195.  
  1196. function lsLeftPadChF(A : LongString; Ch : Char; Len : word)  : LongString;
  1197.   {-Left-pad the LongString in A to length Len with Ch, returning B}
  1198.   var
  1199.     ThisLs  : LongString;
  1200.   begin
  1201.     ThisLs := NextInRing(Len);
  1202.     lsLeftPadCh(A, Ch, Len, ThisLs);
  1203.     lsLeftPadChF := ThisLs;
  1204.     end; {lsLeftPadChF}
  1205.  
  1206. procedure lsLeftPad(A : LongString; Len : word; B : LongString);
  1207.   {-Left-pad the LongString in A to length Len with blanks, returning B}
  1208.   begin
  1209.     lsLeftPadCh(A, Blank, Len, B);
  1210.     end; {lsLeftPad}
  1211.  
  1212. function lsLeftPadF(A : LongString; Len : word) : LongString;
  1213.   {-Left-pad the LongString in A to length Len with blanks, returning B}
  1214.   begin
  1215.     lsLeftPadF := lsLeftPadChF(A, Blank, Len);
  1216.     end; {lsLeftPad}
  1217.  
  1218. procedure lsTrimLeadSet(A : LongString; CS : CharSet; B : LongString);
  1219.   {-Returns a LongString with leading characters in CS stripped.}
  1220.   var
  1221.     W1    : word;
  1222.   begin
  1223.     lsTransfer(A, B);
  1224.     W1 := lsPosSet([#0..#255] - CS, B);
  1225.     if W1 <> 0 then
  1226.       lsDelete(B, 1, pred(W1), B);
  1227.     end; {lsTrimLeadSet}
  1228.  
  1229. function lsTrimLeadSetF(A : LongString; CS : CharSet) : LongString;
  1230.   {-Returns a LongString with leading characters in CS stripped.}
  1231.   var
  1232.     ThisLS  : LongString;
  1233.   begin {lsTrimLeadSetF}
  1234.     ThisLs := NextInRing(A^.Length);
  1235.     lsTrimLeadSet(A, CS, ThisLs);
  1236.     lsTrimLeadSetF := ThisLs;
  1237.     end; {lsTrimLeadSetF}
  1238.  
  1239. procedure lsTrimTrailSet(A : LongString; CS : CharSet; B : LongString);
  1240.   {-Returns a LongString with trailing characters in CS stripped.}
  1241.   var
  1242.     W1    : word;
  1243.   begin
  1244.     lsTransfer(A, B);
  1245.     W1 := B^.Length;
  1246.     while (W1 >= 1) and (B^.lsData[W1] in CS) do begin
  1247.       dec(W1);
  1248.       dec(B^.Length);
  1249.       end;
  1250.     end; {lsTrimTrailSet}
  1251.  
  1252. function lsTrimTrailSetF(A : LongString; CS : CharSet) : LongString;
  1253.   {-Returns a LongString with trailing characters in CS stripped.}
  1254.   var
  1255.     ThisLs  : LongString;
  1256.   begin {lsTrimTrailSetF}
  1257.     ThisLs := NextInRing(A^.Length);
  1258.     lsTrimTrailSet(A, CS, ThisLs);
  1259.     lsTrimTrailSetF := ThisLs;
  1260.     end; {lsTrimTrailSetF}
  1261.  
  1262. procedure lsTrimSet(A : LongString; CS : CharSet; B : LongString);
  1263.   {-Returns a LongString with characters in CS stripped.}
  1264.   var
  1265.     ThisLs  : LongString;
  1266.   begin
  1267.     if not lsInit(ThisLs, A^.Length) then exit;
  1268.     lsTransfer(A, ThisLs);
  1269.     lsTrimLeadSet(lsTrimTrailSetF(ThisLs, CS), CS, B);
  1270.     lsDispose(ThisLs);
  1271.     end; {lsTrimSet}
  1272.  
  1273. function lsTrimSetF(A  : LongString; CS : CharSet) : LongString;
  1274.   {-Returns a LongString with characters in CS stripped.}
  1275.   var
  1276.     ThisLs  : LongString;
  1277.   begin
  1278.     ThisLs := NextInRing(A^.Length);
  1279.     lsTrimSet(A, CS, ThisLs);
  1280.     lsTrimSetF := ThisLs;
  1281.     end; {lsTrimSetF}
  1282.  
  1283. procedure lsTrimLead(A, B : LongString);
  1284.   {-Return a LongString with leading white space removed}
  1285.   var
  1286.     W1    : word;
  1287.   begin
  1288.     lsTransfer(A, B);
  1289.     W1 := 1;
  1290.     while (W1 <= B^.Length) and (B^.lsData[W1] <= Blank) do
  1291.       inc(W1);
  1292.     if W1 <= B^.Length then begin
  1293.       move(B^.lsData[W1], B^.lsData[1], B^.Length - W1 + 1);
  1294.       B^.Length := B^.Length - W1 + 1;
  1295.       end;
  1296.     end; {lsTrimLead}
  1297.  
  1298. function lsTrimLeadF(A  : LongString): LongString;
  1299.   {-Return a LongString with leading white space removed}
  1300.   var
  1301.     ThisLs  : LongString;
  1302.   begin
  1303.     ThisLs := NextInRing(A^.Length);
  1304.     lsTrimLead(A, ThisLs);
  1305.     lsTrimLeadF := ThisLs;
  1306.     end; {lsTrimLeadF}
  1307.  
  1308. procedure lsTrimTrail(A, B : LongString);
  1309.   {-Return a LongString with trailing white space removed}
  1310.   var
  1311.     W1    : word;
  1312.   begin
  1313.     lsTransfer(A, B);
  1314.     W1 := B^.Length;
  1315.     while (W1 >= 1) and (B^.lsData[W1] <= Blank) do begin
  1316.       dec(W1);
  1317.       dec(B^.Length);
  1318.       end;
  1319.     end; {lsTrimTrail}
  1320.  
  1321. function lsTrimTrailF(A : LongString) : LongString;
  1322.   {-Return a LongString with trailing white space removed}
  1323.   var
  1324.     ThisLs  : LongString;
  1325.   begin
  1326.     ThisLs := NextInRing(A^.Length);
  1327.     lsTrimTrail(A, ThisLs);
  1328.     lsTrimTrailF := ThisLs;
  1329.     end; {lsTrimTrailF}
  1330.  
  1331. procedure lsTrim(A, B : LongString);
  1332.   {-Return a LongString with leading and trailing white space removed}
  1333.   var
  1334.     ThisLs  : LongString;
  1335.   begin
  1336.     if not lsInit(ThisLs, A^.Length) then exit;
  1337.     lsTransfer(A, ThisLs);
  1338.     lsTrimLead(lsTrimTrailF(ThisLs), B);
  1339.     lsDispose(ThisLs);
  1340.     end; {lsTrim}
  1341.  
  1342. function lsTrimF(A  : LongString) : LongString;
  1343.   {-Return a LongString with leading and trailing white space removed}
  1344.   var
  1345.     ThisLs  : LongString;
  1346.   begin
  1347.     ThisLs := NextInRing(A^.Length);
  1348.     lsTrim(A, ThisLs);
  1349.     lsTrimF := ThisLs;
  1350.     end; {lsTrimF}
  1351.  
  1352. procedure lsCenterCh(A : LongString; Ch : Char; Width : word; B : LongString);
  1353.   {-Return a LongString centered in a LongString of Ch with specified Width}
  1354.   var
  1355.     W1      : word;
  1356.   begin
  1357.     lsTransfer(A, B);
  1358.     if Width > B^.dLength then exit;
  1359.     if Width < B^.Length then begin
  1360.       B^.Length := Width;
  1361.       exit;
  1362.       end;
  1363.     W1 := Width - ((Width - B^.Length) shr 1);
  1364.     lsLeftPadCh(B, Ch, W1, B);
  1365.     lsPadCh(B, Ch, Width, B);
  1366.     end; {lsCenterCh}
  1367.  
  1368. function lsCenterChF(A : LongString; Ch : Char; Width : word) : LongString;
  1369.   {-Return a LongString centered in a LongString of Ch with specified width}
  1370.   var
  1371.     ThisLs  : LongString;
  1372.   begin
  1373.     ThisLs := NextInRing(Width);
  1374.     lsCenterCh(A, Ch, Width, ThisLs);
  1375.     lsCenterChF := ThisLs;
  1376.     end; {lsCenterChF}
  1377.  
  1378. procedure lsCenter(A : LongString; Width : word; B : LongString);
  1379.   {-Return a LongString centered in a LongString of blanks with specified width}
  1380.   begin
  1381.     lsCenterCh(A, Blank, Width, B);
  1382.     end; {lsCenter}
  1383.  
  1384. function lsCenterF(A : LongString; Width : word)  : LongString;
  1385.   {-Return a LongString centered in a LongString of blanks with specified width}
  1386.   var
  1387.     ThisLs  : LongString;
  1388.   begin
  1389.     ThisLs := NextInRing(Width);
  1390.     lsCenterCh(A, Blank, Width, ThisLs);
  1391.     lsCenterF := ThisLs;
  1392.     end; {lsCenterF}
  1393.  
  1394. procedure lsIon;
  1395.   {-Has the same effect with respect to lsReadLn, lsWriteLn as the $I+
  1396.     compiler has with respect to normal I/O operations, except that
  1397.     the reported error address is meaningless.}
  1398.   begin
  1399.     lsIoCheck := true;
  1400.     end; {lsIon}
  1401.  
  1402. procedure lsIoff;
  1403.   {-Has the same effect with respect to lsReadLn, lsWriteLn as the $I-
  1404.     compiler has with respect to normal I/O operations, except that
  1405.     the reported error address is meaningless.}
  1406.   begin
  1407.     lsIoCheck := false;
  1408.     end; {lsIoff}
  1409.  
  1410. procedure SetIoRes;
  1411.   begin
  1412.     lsIoRes := IoResult;
  1413.     if lsIoCheck and (lsIoRes <> 0) then
  1414.       RunError(lsIoRes);
  1415.     end; {SetIoRes}
  1416.  
  1417. procedure CheckIoRes;
  1418.   begin
  1419.     if (lsIoRes <> 0) then
  1420.       RunError(lsIoRes);
  1421.     end;
  1422.  
  1423. function lsIoResult : word;
  1424.   {-Returns the value of IoResult resulting from the last lsReadLn or
  1425.     lsWriteLn. NOTE: You MUST use lsIoResult for checking lsReadLn,
  1426.     lsWriteLn. If you call IoResult instead, you will always get a 0
  1427.     return.}
  1428.   begin
  1429.     lsIoResult := lsIoRes;
  1430.     lsIoRes := 0;
  1431.     end;
  1432.  
  1433. {$I-}
  1434. procedure lsReadLn(var F  : text; A : LongString);
  1435.   {-Reads a LongString from a text file. Returns the value of IoResult as
  1436.    the function value.}
  1437.   var
  1438.     S   : string;
  1439.     W1  : word;
  1440.   begin
  1441.     CheckIoRes;
  1442.     A^.Length := 0;
  1443.     while (not eoln(F)) and (A^.dLength > A^.Length) do begin
  1444.       Read(F, S);
  1445.       SetIoRes;
  1446.       if lsIoRes <> 0 then begin
  1447.         exit;
  1448.         end;
  1449.       lsConcatStr2Ls(A, S, A);
  1450.       end; {while}
  1451.     ReadLn(F);
  1452.     SetIoRes;
  1453.     end; {lsReadLn}
  1454.  
  1455. procedure lsWriteLn(var F  : text; A : LongString);
  1456.   {-Writes a LongString to a text file. Returns the value of IoResult as
  1457.    the function value.}
  1458.   var
  1459.     S       : string;
  1460.     W1,
  1461.     W2,
  1462.     Q,
  1463.     R       : word;
  1464.     ThisLs  : LongString;
  1465.   begin
  1466.     CheckIoRes;
  1467.     if not lsInit(ThisLs, A^.Length) then exit;
  1468.     lsTransfer(A, ThisLs);
  1469.     Q := A^.Length div $FF;
  1470.     R := A^.Length mod $FF;
  1471.     for W1 := 1 to Q do begin
  1472.       Write(F, lsLongString2Str(ThisLs));
  1473.       SetIoRes;
  1474.       Flush(F);
  1475.       SetIoRes;
  1476.       if lsIoRes <> 0 then begin
  1477.         lsDispose(ThisLs);
  1478.         exit;
  1479.         end;
  1480.       lsDelete(ThisLs, 1, $FF, ThisLs);
  1481.       end; {for W1}
  1482.     WriteLn(F, lsLongString2Str(ThisLs));
  1483.     SetIoRes;
  1484.     Flush(F);
  1485.     SetIoRes;
  1486.     lsDispose(ThisLs);
  1487.     end; {lsWriteLn}
  1488. {$I+}
  1489.   end.
  1490.